perm filename HISSEG.SAI[3,ALS] blob
sn#050678 filedate 1973-06-27 generic text, type T, neo UTF8
00010 BEGIN "SEGMENT"
00020 DEFINE ⊂="COMMENT"; ⊂ 5/30/73;
00030 ⊂ This program has been simplified for use in getting
00040 histographs;
00050
00060 DEFINE INSIZ="24";
00070 REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00080 EXTERNAL STRING PROCEDURE INCHWL;
00090 EXTERNAL PROCEDURE SPOOL(STRING S; INTEGER IOCHAN,FLAGS);
00100 DEFINE BUFSIZ="1024",CNTSIZ="100";
00110 STRING TFILEI,FILEI,OPT1,MESS,GATENA,SPONAM;
00120 INTERNAL INTEGER ARRAY DATBUF[0:BUFSIZ];
00130 INTEGER ARRAY LFILE[0:'177];
00140 INTEGER CHAN1,CHAN4,CHAN6,EOF,IEOF,FILEC,CHAN2;
00150 INTEGER BPT,SEGCNT,SEGTOT,H,I,J,K,L,Q,ZZ;
00160 INTERNAL INTEGER M,N,P,RATE,FLAG,SEGC,INTOT,HINT,TFLAG,UPCNT;
00170 INTEGER ARRAY INDAT[0:24];
00180 LABEL START,LABELA,LABELB,ZZZZ,FINISH;
00190 INTEGER ARRAY COUNT[0:24,0:64];
00200 INTEGER ARRAY SUM[0:24];
00210 INTEGER BIN,GFLAG,GVAL;
00220 INTEGER HINCNT,HCOUNT,HINDEX;
00230 STRING PREHINT;
00240 INTEGER ARRAY PHLIST,HLIST[0:64];
00250 INTEGER ARRAY FLIST[0:35];
00260
00270 DEFINE ⊂="COMMENT",CR="'15",LF="'12",FF="'14",TB="'11";
00280 DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
00290 DEFINE TTY="'14",DSK="'13",BDSKO="'12",DPY="'11",BDSKI="'10",TMP="'0";
00300
00310 INTERNAL PROCEDURE LOOKIN(INTEGER CHAN; REFERENCE STRING FILENAME);
00320 BEGIN ⊂ REQUIRES SETBREAK(1,CR,LF,"IN");
00330 BOOLEAN NF;
00340 LOOKUP(CHAN,FILENAME,NF);
00350 WHILE NF DO
00360 BEGIN
00370 OUTSTR(CR&LF&"Can't find "&FILENAME&". try [1,VIN], File=");
00380 FILENAME ← INCHWL ;
00390 LOOKUP(CHAN,FILENAME,NF)
00400 END;
00410 END "LOOKIN";
00420
00430 STRING PROCEDURE HEADER;
00440 BEGIN "HEADER"
00450 STRING H1,H2; INTEGER I,J,K;
00460 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; HINCNT←HINCNT+1; RETURN(PREHINT) END
00470 ELSE WHILE HCOUNT=0 DO BEGIN "XX"
00480 I←LFILE[HINDEX]; K←LDB(POINT(12,I,23)); J←SEGC-K;
00490 IF I=0 THEN BEGIN PREHINT←"NU"; HCOUNT←999; RETURN(PREHINT) END;
00500 IF J ≥ 0 THEN BEGIN "LATCH" H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
00510 H2←CVXSTR(LDB(POINT(12,I,23)) LSH 24);
00520 IF EQU(H1,H2) THEN BEGIN
00530 OUTSTR(CRLF&"Old HEADER version, refuse to learn");
00540 HCOUNT←999; PREHINT←"NU"; RETURN("NU"); END;
00550
00560 IF H1≠0 THEN BEGIN
00570 PREHINT←H1; HCOUNT←LDB(POINT(12,I,35));
00580 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; HINCNT←HINCNT+1;
00590 RETURN(PREHINT); DONE END
00600 ELSE BEGIN PREHINT←"NU"; HCOUNT←LDB(POINT(12,I,35));
00610 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE; END;
00620 END "LATCH";
00630 PREHINT←"NU"; RETURN(PREHINT); END "XX";
00640 END "HEADER";
00010 FILEI←"SEG1.T0[77,THO]";UPCNT←3;OPT1←"N";FILEC←0; CHAN4←4;CHAN6←6; CHAN2←2;CHAN1←1;
00020 OUTSTR("This program computes a histogram of data on T0 files"&crlf);
00030 BIN←16;
00040 IF (TFILEI←STRIN("Number of bins (CR for 16) =? "))≠"" then bin←cvd(tfilei);
00050 WHILE TRUE DO
00060 IF (GATENA←STRIN("Gate on Ph or Feature (CR for no gate)= "))="" then
00070 BEGIN GFLAG←0; GATENA←"HISTOG"; DONE END ELSE BEGIN
00080 GFLAG←1; I←CVSIX(GATENA);
00090 CHAN1←GETCHAN; CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00100 LOOKUP(CHAN1,"TABLES.DAT[8,ALS]",0);
00110 ARRYIN(CHAN1,LFILE[0],INSIZ*4);
00120 ARRYIN(CHAN1,FLIST[0],36);
00130 ARRYIN(CHAN1,PHLIST[0],64);
00140 ARRYIN(CHAN1,HLIST[0],64); CLOSE(CHAN1);
00150 FOR J←0 STEP 1 UNTIL 63 DO IF PHLIST[J]=I THEN DONE;
00160 IF J≤63 THEN BEGIN GVAL←PHLIST[J]; DONE END ELSE BEGIN
00170 FOR J←0 STEP 1 UNTIL 35 DO IF FLIST[J]=I THEN DONE;
00180 IF J≤35 THEN BEGIN GVAL←(1 LSH (35-J)); GFLAG←2; DONE END ELSE
00190 OUTSTR("Gate not identified"&CRLF); END;
00200 END;
00210
00220 CLOSE(CHAN2); OPEN(CHAN2,"DSK",0,0,'10,0,0,0);
00230 SPONAM←GATENA&".HIS";
00240 ENTER(CHAN2,SPONAM,0);
00250 setformat(1,0);
00260 OUT(CHAN2,"Histogram in parts per 512 with "&cvs(bin)&" bins."
00270 &TB&TB&DATIME&CRLF);
00280 IF GFLAG≠0 THEN OUT(CHAN2,LF&" Gated on "&GATENA);
00290 OUT(CHAN2,CRLF&LF&"Based on files ");
00300 ⊂ **** MAIN ROUTINE STARTS HERE****;
00310 WHILE TRUE DO BEGIN
00320 START: CLOSE(CHAN6);
00330 IF OPT1≠"Y" THEN
00340 IF (TFILEI←STRIN("Data file FFT/LPC ("&FILEI&")="))≠"" THEN FILEI←TFILEI
00350 ELSE OPT1←"Y";
00360 IF FILEI="E" THEN DONE;
00370 IF OPT1="Y" THEN BEGIN FILEC←FILEC+1; SETFORMAT(1,0);
00380 IF FILEC>31 THEN DONE;
00390 FILEI←"SEG"&CVS(FILEC)&".T0[77,THO]"; END;
00400
00410 CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00420 LOOKIN(CHAN4,FILEI); EOF←SEGC←SEGCNT←0;
00430 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
00440 IF LFILE[21]=0 THEN DONE; ⊂ No more hints;
00450 HINDEX←21; HCOUNT←HINCNT←0;
00460 SEGTOT←(LFILE[0])*3%128; RATE←LFILE[2];
00470 OUT(CHAN2," "&FILEI); OUTSTR(" "&FILEI);
00480
00490
00500
00510 WHILE EOF=0 DO BEGIN "DATAIN"
00520 ARRYIN(CHAN4,DATBUF[0],BUFSIZ); ⊂ Get data;
00530 BPT←POINT(6,DATBUF[0],-1);
00540
00550 FOR Q←1 STEP 1 UNTIL BUFSIZ%4 DO BEGIN
00560 SEGC←SEGC+1;
00570 IF SEGC>SEGTOT THEN DONE;
00580
00590 FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
00600 WHILE TRUE DO BEGIN
00610 IF GFLAG≠0 THEN BEGIN I←CVSIX(HEADER); IF GFLAG=1 THEN BEGIN
00620 IF I≠GVAL THEN DONE; END ELSE BEGIN
00630 FOR J←0 STEP 1 UNTIL 63 DO IF I=PHLIST[J] THEN DONE;
00640 IF J>63 THEN DONE ELSE IF (HLIST[J] LAND GVAL)=0 THEN DONE; END; END;
00650 FOR P←0 STEP 1 UNTIL 23 DO BEGIN
00660 J←INDAT[P]; COUNT[P,J]←COUNT[P,J]+1; sum[p]←sum[p]+1; END;DONE END;
00670 END;
00680 IF SEGC>SEGTOT THEN DONE;
00690 END "DATAIN"; CLOSE(CHAN4); END; close(chan4); ⊂ Safety close on no hints;
00700 H←64/BIN;
00710 SETFORMAT(4,0);
00720 out(chan2,CRLF&LF&" Bin\ In");
00730 FOR P←0 STEP 1 UNTIL 18 DO OUT(CHAN2,CVS(P));
00740 OUT(CHAN2,CRLF&LF);
00750 FOR J←0 STEP 1 UNTIL BIN-1 DO BEGIN
00760 OUT(CHAN2,CVS(J)&TB); I←J*H;
00770 FOR P←0 STEP 1 UNTIL 18 DO BEGIN
00780 ZZ←0;
00790 FOR K←0 STEP 1 UNTIL H-1 DO BEGIN
00800 L←I+K; ZZ←ZZ+COUNT[P,L]; END;
00810 ZZ←((ZZ*1024)/SUM[P]+1)/2;
00820 OUT(CHAN2,CVS(ZZ)); END;
00830 OUT(CHAN2,CRLF); END;
00840 OUT(CHAN2,CRLF&" Sums"&TB);
00850 FOR K←0 STEP 2 UNTIL 18 DO OUT(CHAN2,CVS(SUM[K])&" ");
00860 OUT(CHAN2,CRLF&TB&" ");
00870 FOR K←1 STEP 2 UNTIL 18 DO OUT(CHAN2,CVS(SUM[K])&" ");
00880 OUT(CHAN2,CRLF); CLOSE(CHAN2);
00890 SPOOL(SPONAM,GETCHAN,0);
00900
00910 END "SEGMENT";